home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1991-05-27 | 25.2 KB | 791 lines |
- (*# call(o_a_copy => off) *)
- (*%T _fcall *)
- (*# call(seg_name => QCxm) *)
- (*%E *)
- (*%F _fcall *)
- (*# call(seg_name => null) *)
- (*%E *)
- (*# module(implementation=>on) *)
- (*# data(seg_name => null) *)
- (*# data(const_assign => on) *)
- IMPLEMENTATION MODULE QCxm;
-
- (* This JPI Modula-2 module is part of *)
-
- (* QC -- a communications program *)
- (* by Carl Neiburger *)
- (* 169 N. 25th St.*)
- (* San Jose, Calif. 95116 *)
-
- (* CompuServe No. 72336,2257 *)
-
- IMPORT NFIO;
- FROM Str IMPORT Append, CardToString, Concat, Copy, Length, Pos, Delete,
- Insert;
- FROM QCcomm IMPORT ComAbort, ComTimedOut, CommRdData, CommRdDataTest,
- CommWrData, setXon, ack, eot, can, cee, esc, nak, soh, stx, syn, sub;
- FROM QCxmzero IMPORT BPtr, ZeroBlockProtos, CreateBlock, InterpretBlock,
- TelinkBlockType, BasicBlock;
- FROM QCdisp IMPORT DataLeft, DataRegisters, Errs, Packets, PressKey,
- PromptForString, QCDefPtr, ShowTransferTime, ShowErrorType,
- ShowFileName, ShowPacketSize, StartDisplay, StatusMessage, StopDisplay,
- IncrDataBytes, UpdateData, Yes, DisplayData, ShowTimeLeft,
- AbortMsg, TimeoutAbortMsg, TimeoutMsg, ProtoType, YModem, Telink,
- CloseError, CreateError, OpenError, FlushLog;
- FROM Lib IMPORT Fill;
- FROM CRC IMPORT DoCRC, DoCks, ChkProc;
- FROM UTIL IMPORT NUMSET, SBITSET, str10, str80, FiChars;
- FROM FioAsm IMPORT DiskFree, SetFileTime, PathTail;
- FROM Storage IMPORT ALLOCATE, DEALLOCATE;
- FROM PathFind IMPORT ParsePath;
- FROM Timer IMPORT StartTimer, ForTransfer, ForPacket;
- FROM MiscAsm IMPORT HI;
-
- TYPE
- RateValType = ARRAY BOOLEAN OF CARDINAL;
- A2 = ARRAY[0..1] OF SHORTCARD;
-
- CONST
- MaxErrors = 10;
- SendDelay = 10; (* number of seconds to wait for ack *)
- RateVal = RateValType(18, 26);
- XmProtos = ProtoSet{XModem, XModem1K, YModem, Telink};
- OneKProtos = ProtoSet{XModem1K, YModem};
- NoTransferMsg = 'Cannot start transfer.';
- CancelMsg = 'Cancel received.';
- BlockCrossover = 5*128+1; (* When using 1K protocol, switch to 128-byte *)
- (* blocks if there are fewer than this many *)
- (* bytes left. *)
- VAR
- Protocol : ProtoType;
- Buffer : BPtr;
- ZeroBlock: TelinkBlockType;
- fi : NFIO.File;
- BlockSize,
- CRCvalue : CARDINAL;
- Aborting,
- UsingCRC : BOOLEAN;
- UpdChk : ChkProc;
- BytesToGo,
- blockCount : LONGCARD;
- MsgStr : str80;
-
- PROCEDURE GracefulAbort(message : str80);
- VAR i : SHORTCARD;
- BEGIN
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- FOR i := 1 TO 8 DO
- CommWrData(can)
- END;
- FOR i := 1 TO 8 DO
- CommWrData(8H) (* backspace to clear receiver's buffer *)
- END;
- NFIO.Close(fi);
- Aborting := TRUE;
- StatusMessage(message, TRUE);
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- END GracefulAbort;
-
- PROCEDURE ShowFileData(Name: ARRAY OF CHAR; Receiving: BOOLEAN);
- BEGIN
- ShowFileName(Name, Receiving);
- ShowErrorType(UsingCRC);
- Fill( ADR(DataRegisters), SIZE(DataRegisters), 0);
- DataRegisters[Receiving, DataLeft] := BytesToGo;
- StartTimer(ForTransfer);
- StartTimer(ForPacket);
- IF BytesToGo > 0 THEN
- ShowTimeLeft( Receiving );
- END;
- END ShowFileData;
-
- PROCEDURE ReadByte(VAR c: BYTE): BOOLEAN;
- VAR dat: CARDINAL;
- BEGIN
- dat := CommRdData( SendDelay );
- CASE dat OF
- ComAbort: GracefulAbort(AbortMsg);
- RETURN FALSE;
- |ComTimedOut: RETURN FALSE;
- ELSE c:= VAL(BYTE, dat);
- RETURN TRUE
- END;
- END ReadByte;
-
- PROCEDURE ReceiveXmodem( FilePath, FileName : PathStr );
-
- TYPE
- RecvStateType = (
- XStart,
- XGet1st,
- XGetName,
- XGetData);
-
- VAR
- State : RecvStateType;
- Number,
- Errors,
- LastNum : SHORTCARD;
- UseTempName : BOOLEAN;
-
- PROCEDURE GetTelinkName(): BOOLEAN;
- CONST LastTelinkMsg = 'Last Telink file.';
- VAR ch : SHORTCARD; len: SHORTCARD;
- BEGIN
- Errors := 0;
- StatusMessage('Getting file information', FALSE);
- LOOP
- LOOP
- CommWrData(nak);
- IF ReadByte( ch ) THEN
- CASE ch OF
- ack: EXIT;
- |eot: CommWrData(ack);
- StatusMessage(LastTelinkMsg, FALSE);
- RETURN FALSE
- ELSE INC (Errors);
- END
- ELSE
- IF Aborting THEN
- RETURN FALSE
- END;
- INC (Errors);
- END;
- IF Errors >= MaxErrors THEN
- StatusMessage(TimeoutAbortMsg, FALSE);
- RETURN FALSE
- END
- END;
- CRCvalue := 0;
- len := 0;
- LOOP
- IF ReadByte( ch ) THEN
- CASE ch OF sub:
- INC( CRCvalue, sub );
- CommWrData( SHORTCARD( CRCvalue ) );
- IF ReadByte(ch) THEN
- IF ch = ack THEN
- RETURN TRUE
- END;
- INC(Errors);
- EXIT
- ELSE
- GracefulAbort(NoTransferMsg);
- RETURN FALSE
- END;
- |eot: CommWrData(ack);
- StatusMessage(LastTelinkMsg, FALSE);
- RETURN FALSE;
- ELSE
- CommWrData( ack );
- INC( CRCvalue, ORD(ch) );
- INC( len );
- IF len > 12 THEN
- GracefulAbort(NoTransferMsg);
- RETURN FALSE
- END;
- END; (* CASE *)
- ELSE
- IF NOT Aborting THEN
- StatusMessage(NoTransferMsg, FALSE);
- END;
- RETURN FALSE
- END
- END;
- INC( Errors );
- IF Errors > MaxErrors THEN
- GracefulAbort(NoTransferMsg);
- RETURN FALSE
- END
- END
- END GetTelinkName;
-
- PROCEDURE FileParamsSet(): BOOLEAN;
- VAR ClusterSize: CARDINAL; Error : BOOLEAN; FileTail: PathTail;
-
- BEGIN
- IF ZeroBlock.FileName[0] = 0C THEN
- RETURN FALSE
- END;
- Copy( FileName, ZeroBlock.FileName );
- BytesToGo := ZeroBlock.FileLength;
- IF BytesToGo > 0 THEN
- Error := FALSE;
- WHILE Error OR
- ( DiskFree( VAL(SHORTCARD,CAP(FilePath[0]) )
- - SHORTCARD('@'), ClusterSize) < BytesToGo ) DO
- IF NOT PromptForString(
- 'Insufficient disk space: New directory or Return to cancel', FilePath) THEN
- GracefulAbort(AbortMsg);
- RETURN FALSE
- END;
- FileTail[0] := 0C;
- Error := NOT ParsePath(FilePath, FileTail);
- END;
- END;
- Concat(FileName, FilePath, FileName);
- RETURN TRUE
- END FileParamsSet;
-
- PROCEDURE FirstLeader() : BOOLEAN;
- CONST MaxFLerrs = 20;
- VAR ch, FLerrs: SHORTCARD; gotCan: BOOLEAN;
- BEGIN
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- FLerrs := 0;
- gotCan := FALSE;
- ch := cee;
- REPEAT
- CommWrData(ch); (*request CRC*)
- CASE CommRdDataTest( 2 ) OF
- ComAbort: GracefulAbort(AbortMsg);
- RETURN FALSE;
- |soh : RETURN TRUE;
- |stx : BlockSize := 1024;
- RETURN TRUE
- |syn : Protocol := Telink;
- RETURN TRUE;
- |can : IF gotCan THEN
- StatusMessage(CancelMsg, FALSE);
- RETURN FALSE
- END;
- gotCan := TRUE;
- |eot : CommWrData(ack);
- (* RETURN FALSE; *)
- |ComTimedOut: StatusMessage(TimeoutMsg, FALSE);
- |ELSE WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- END; (* CASE *)
- INC(FLerrs);
- IF FLerrs = 3 THEN
- ch := nak;
- UsingCRC := FALSE;
- UpdChk := DoCks;
- END
- UNTIL FLerrs >= MaxFLerrs;
- StatusMessage(TimeoutAbortMsg, FALSE);
- RETURN FALSE
- END FirstLeader;
-
- PROCEDURE SendAck(Good: BOOLEAN);
- BEGIN
- IF Good THEN
- CommWrData(ack);
- Errors := 0;
- INC( DataRegisters[TRUE, Packets]);
- ELSE
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- CommWrData(nak);
- INC(Errors);
- INC( DataRegisters[TRUE, Errs]);
- END;
- UpdateData;
- END SendAck;
-
- PROCEDURE NextLeader(): SHORTCARD;
- VAR x : CARDINAL;
- BEGIN
- REPEAT
- CASE CommRdDataTest( SendDelay ) OF
- ComAbort: GracefulAbort(AbortMsg);
- RETURN 0FFH;
- |soh : BlockSize := 128;
- RETURN soh;
- |stx : BlockSize := 1024;
- RETURN soh
- |eot : SendAck(TRUE);
- RETURN eot;
- |can : x := CommRdData( SendDelay );
- IF (x >= ComAbort) OR (x = can) THEN
- StatusMessage(CancelMsg, FALSE);
- RETURN 0FFH
- END
- |ComTimedOut: StatusMessage(TimeoutMsg, FALSE);
- INC(Errors);
- ELSE WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- END;
- SendAck(FALSE);
- UNTIL Errors > MaxErrors;
- GracefulAbort(TimeoutAbortMsg);
- RETURN 0FFH
- END NextLeader;
-
- PROCEDURE OpenFile(): BOOLEAN;
- BEGIN
- fi := NFIO.Create(FileName);
- IF fi = MAX (CARDINAL) THEN
- GracefulAbort(CreateError);
- RETURN FALSE
- END;
- ShowFileData(FileName, TRUE);
- RETURN TRUE
- END OpenFile;
-
- PROCEDURE WriteBlock (): BOOLEAN;
- VAR ToWrite:CARDINAL;
- BEGIN
- IF (Protocol IN SimpleXmProtos) OR (BytesToGo = 0) THEN
- ToWrite := BlockSize
- ELSE
- IF BytesToGo > VAL( LONGCARD, BlockSize ) THEN
- ToWrite := BlockSize
- ELSE
- ToWrite := VAL( CARDINAL, BytesToGo )
- END;
- IF ToWrite = 0 THEN
- RETURN TRUE;
- END
- END;
- IncrDataBytes( ToWrite, TRUE );
- NFIO.WrBin ( fi, Buffer^[1], ToWrite );
- IF BytesToGo > 0 THEN
- DEC( BytesToGo, VAL(LONGCARD, ToWrite) )
- END;
- RETURN NFIO.OK
- END WriteBlock;
-
- TYPE GetResponse = (GetError, GetGood, GetEmpty);
-
- PROCEDURE GetBlock(GetType: CHAR; UseCRC:BOOLEAN): GetResponse;
- VAR GetOK: BOOLEAN; CrcResult: A2; j : CARDINAL; Complement, i: SHORTCARD;
-
- PROCEDURE WriteIt(): GetResponse;
- BEGIN
- IF NOT WriteBlock() THEN
- GracefulAbort('Cannot write to disk'); (* send can sted of ack *)
- RETURN GetError
- END;
- SendAck(TRUE);
- RETURN GetGood;
- END WriteIt;
-
- BEGIN
- IF UseCRC THEN
- UpdChk := DoCRC
- ELSE
- UpdChk := DoCks
- END;
- IF ReadByte( Number ) AND ReadByte( Complement ) AND
- ( Number + Complement = 255 ) THEN
- IF (Number = (LastNum+1) ) OR (GetType <> 'D') THEN
- FOR j := 1 TO BlockSize DO
- IF NOT ReadByte( Buffer^[j] ) THEN
- RETURN GetEmpty
- END;
- END;
- CRCvalue := UpdChk( Buffer, BlockSize, 0 );
- IF UseCRC THEN
- FOR j := 0 TO 1 DO
- IF NOT ReadByte(CrcResult[j]) THEN
- RETURN GetError
- END;
- END;
- CRCvalue := UpdChk( ADR(CrcResult), 2, CRCvalue );
- ELSE
- IF NOT ReadByte( i ) THEN
- RETURN GetError
- END;
- DEC( CRCvalue, ORD(i) )
- END;
- GetOK := CRCvalue = 0;
- LastNum := Number;
- IF GetOK THEN
- CASE GetType OF
- 'D': RETURN WriteIt();
- |'0': CASE Number OF
- 0: State := XGetName;
- InterpretBlock[Protocol]( Buffer, ZeroBlock);
- |1: Protocol := XModem1K;
- StatusMessage('No file name; saving as XMODEM.$$$', FALSE);
- FileName := 'XMODEM.$$$';
- BytesToGo := 0;
- UseTempName := TRUE;
- State := XGetData;
- RETURN WriteIt();
- |ELSE GetOK := FALSE
- END;
- |'1': CASE Number OF
- 0: Protocol := YModem;
- State := XGetName;
- InterpretBlock[Protocol]( Buffer, ZeroBlock);
- |1: State := XGetData;
- RETURN WriteIt();
- ELSE GetOK := FALSE
- END
- END;
- END; (* IF GetOK *)
- SendAck(GetOK);
- RETURN GetResponse(GetOK)
- END;
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- SendAck(TRUE);
- RETURN GetResponse(Number = LastNum) (* duplicate block is OK *)
- END;
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- SendAck(FALSE);
- RETURN GetError
- END GetBlock;
-
- BEGIN (* ReceiveXmodem *)
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- FlushLog;
- Aborting := FALSE;
- Protocol := QCDefPtr^.Protocol;
- StartDisplay( TRUE, Protocol, TRUE);
- setXon( FALSE, FALSE );
- NEW ( Buffer );
- UsingCRC := TRUE;
- BlockSize := 128;
- StatusMessage('Ready to receive.', FALSE);
- State := XStart;
- UseTempName := FALSE;
- LOOP
- CASE State OF
- XStart: IF Protocol IN SimpleXmProtos THEN
- LastNum := 0
- ELSE
- LastNum := 255
- END;
- Errors := 0;
- IF (Protocol = Telink) AND NOT GetTelinkName() THEN
- EXIT (* INCLUDES ABORT *)
- END;
- INC(State);
- |XGet1st: IF NOT FirstLeader() THEN
- EXIT (* INCLUDES ABORT *)
- END;
- IF (Protocol IN SimpleXmProtos) THEN
- INC(State)
- ELSE
- CASE (GetBlock('0', Protocol <> Telink)) OF
- GetError: IF Aborting THEN (* ABORT *)
- EXIT
- ELSIF (Errors > MaxErrors) THEN
- StatusMessage(NoTransferMsg, FALSE);
- EXIT
- END;
- |GetEmpty: EXIT;
- END END; (* ELSE, CASE *)
- |XGetName: IF (Protocol IN ZeroBlockProtos) THEN
- IF NOT FileParamsSet() THEN
- EXIT
- END
- ELSE
- BytesToGo := 0
- END;
- IF NOT OpenFile() THEN
- EXIT
- END;
- CASE Protocol OF
- XModem, XModem1K: IF GetBlock('1', UsingCRC) <> GetGood THEN
- EXIT (* INCLUDES ABORT *)
- END;
- |Telink: INC(State);
- |YModem: IF NOT FirstLeader() THEN
- EXIT (* INCLUDES ABORT *)
- END;
- IF GetBlock('D', UsingCRC) <> GetGood THEN
- EXIT (* INCLUDES ABORT *)
- END;
- INC(State);
- END; (* CASE *)
- |XGetData: CASE NextLeader() OF
- soh: IF GetBlock('D', UsingCRC) <> GetGood THEN
- EXIT (* INCLUDES ABORT *)
- END;
- |eot: IF (Protocol IN ZeroBlockProtos)
- AND (ZeroBlock.FileTime > 0)
- AND SetFileTime(fi,ZeroBlock.FileTime) THEN
- END;
- NFIO.Close(fi);
- ShowTransferTime;
- IF NOT NFIO.OK THEN
- StatusMessage( CloseError, FALSE);
- EXIT
- END;
- CommWrData(ack);
- IF Protocol IN SimpleXmProtos THEN
- CommWrData(nak); (* ????? CHECK *)
- IF UseTempName AND PromptForString(
- 'New name for file (now XMODEM.$$$): ', FileName) THEN
- NFIO.Rename('XMODEM.$$$', FileName)
- END;
- EXIT
- ELSE
- State := XStart
- END
- |ELSE EXIT (* timed out OR ABORT *)
- END (* CASE NextLeader() *)
- END; (* CASE State *)
- END; (* LOOP *)
- DISPOSE( Buffer );
- setXon( TRUE, TRUE );
- StopDisplay;
- END ReceiveXmodem;
-
- PROCEDURE SendXmodem( ThisFile: FilePtr );
- VAR
- c, Errors, totalErrors: SHORTCARD;
- BlockNum : SHORTCARD;
- FileName : PathTail;
-
- PROCEDURE GetAck(seconds: CARDINAL; OKChrs: NUMSET ): SHORTCARD;
- VAR c : CARDINAL;
- BEGIN
- c := CommRdDataTest( seconds );
- CASE c OF
- ComAbort: GracefulAbort(AbortMsg);
- RETURN esc;
- |ComTimedOut: RETURN 0FFH
- |can: c := CommRdDataTest( seconds );
- IF (c >= ComAbort) OR (c = can) THEN
- UpdateData;
- RETURN can
- END
- END; (* CASE *)
- IF VAL(SHORTCARD,c) IN OKChrs THEN
- UpdateData;
- RETURN VAL(SHORTCARD, c)
- END;
- RETURN 0FFH
- END GetAck;
-
- PROCEDURE SendTelinkName(): BOOLEAN;
- VAR i : CARDINAL; ch : SHORTCARD;
- BEGIN
- IF GetAck(4*SendDelay, NUMSET{nak}) <> nak THEN
- IF NOT Aborting THEN
- StatusMessage(TimeoutAbortMsg, FALSE);
- END;
- RETURN FALSE
- END;
- Errors := 0;
- StatusMessage('Sending file information', FALSE);
- LOOP
- CRCvalue := 0;
- CommWrData(ack);
- i := 0;
- FOR i := 0 TO Length(FileName) - 1 DO
- CommWrData(FileName[i]);
- INC( CRCvalue, ORD(FileName[i]) );
- IF GetAck(SendDelay, NUMSET{ack}) <> ack THEN
- IF NOT Aborting THEN
- GracefulAbort(TimeoutAbortMsg)
- END;
- RETURN FALSE
- END
- END;
- CommWrData(sub);
- INC( CRCvalue, sub );
- IF ReadByte(ch) THEN
- IF ch = SHORTCARD(CRCvalue) THEN
- CommWrData(ack);
- RETURN TRUE
- ELSE
- CommWrData(nak);
- INC (Errors)
- END
- ELSE
- IF NOT Aborting THEN
- StatusMessage(TimeoutAbortMsg, FALSE);
- END;
- RETURN FALSE
- END;
- IF Errors > MaxErrors THEN
- StatusMessage(TimeoutAbortMsg, FALSE);
- RETURN FALSE
- END
- END
- END SendTelinkName;
-
- PROCEDURE ReadBlock() : CARDINAL;
- VAR result : CARDINAL;
- BEGIN
- Fill ( Buffer, SIZE(Buffer^), 32C );
- IF (BlockSize = 1024) AND (BytesToGo >= BlockCrossover) THEN
- Buffer^[1] := stx
- ELSE
- BlockSize := 128;
- Buffer^[1] := soh;
- END;
- Buffer^[2] := BlockNum;
- Buffer^[3] := SHORTCARD(SBITSET(BlockNum) / SBITSET(0FFH));
- result := NFIO.RdBin(fi, Buffer^[4], BlockSize );
- IF NOT NFIO.OK THEN
- RETURN 0
- END;
- RETURN result
- END ReadBlock;
-
- PROCEDURE BlockSent(size:CARDINAL; UseCRC, Data: BOOLEAN): BOOLEAN;
- VAR i: CARDINAL;
-
- PROCEDURE ComputeCRC;
- VAR i: CARDINAL;
- BEGIN
- IF UseCRC THEN
- UpdChk := DoCRC
- ELSE
- UpdChk := DoCks
- END;
- CRCvalue := UpdChk( ADR(Buffer^[4]), size, 0 );
- IF UseCRC THEN
- Buffer^[size + 4] := SHORTCARD( HI(CRCvalue) );
- Buffer^[size + 5] := SHORTCARD( CRCvalue )
- ELSE
- Buffer^[size + 4] := SHORTCARD( CRCvalue );
- END
- END ComputeCRC;
-
- BEGIN
- Errors := 0;
- ComputeCRC;
- LOOP
- FOR i := 1 TO size+4+ORD(UseCRC) DO
- CommWrData(Buffer^[i])
- END;
- CASE GetAck(SendDelay, NUMSET{ack, nak, cee} ) OF
- ack: INC(DataRegisters[FALSE, Packets]);
- IF Data THEN
- IncrDataBytes( size, FALSE);
- DEC(BytesToGo, VAL(LONGCARD, size ) );
- END;
- BlockNum := BlockNum + 1;
- EXIT
- |can: StatusMessage(CancelMsg, FALSE);
- RETURN FALSE;
- |esc:
- RETURN FALSE; (* Abort *)
- ELSE
- INC(DataRegisters[FALSE, Errs]);
- INC(Errors);
- DisplayData( Errs, FALSE );
- IF Errors > MaxErrors THEN
- GracefulAbort(TimeoutAbortMsg);
- RETURN FALSE;
- END;
- END; (* CASE *)
- END; (* LOOP *)
- IF BlockSize = 1024 THEN
- INC (totalErrors, Errors );
- IF totalErrors > 2 THEN
- BlockSize := 128;
- StatusMessage('Reducing block size to 128 to reduce delays.', FALSE)
- END
- END;
- RETURN TRUE
- END BlockSent;
-
- PROCEDURE SendFile;
- BEGIN
- BlockNum := 1;
- BytesToGo := NFIO.Size(fi);
- IF (Protocol IN OneKProtos) AND (BytesToGo >= BlockCrossover) THEN
- BlockSize := 1024
- END;
- ShowFileData(ThisFile^.Name, FALSE);
- WHILE (ReadBlock() > 0)
- AND BlockSent(BlockSize, UsingCRC, TRUE) DO
- END;
- ShowTransferTime;
- END SendFile;
-
- PROCEDURE StartingAck(): BOOLEAN;
- BEGIN
- CASE GetAck(4*SendDelay, NUMSET{nak, cee}) OF
- nak: UsingCRC := FALSE;
- |can: StatusMessage(CancelMsg, FALSE);
- RETURN FALSE;
- |esc: RETURN FALSE; (* Abort by user *)
- |cee: UsingCRC := TRUE;
- |0FFH: GracefulAbort(NoTransferMsg);
- RETURN FALSE;
- END; (* CASE *)
- RETURN TRUE
- END StartingAck;
-
- BEGIN (* SendXmodem *)
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- FlushLog;
- Aborting := FALSE;
- setXon( FALSE, FALSE );
- NEW( Buffer );
- Protocol := QCDefPtr^.Protocol;
- StartDisplay( TRUE, Protocol, FALSE);
- LOOP
- IF ThisFile = NIL THEN
- BlockSize := 128;
- CASE Protocol OF
- YModem:
- BasicBlock( Buffer );
- IF NOT BlockSent(128, UsingCRC, FALSE) THEN
- EXIT (* INCLUDES ABORT *)
- END;
- CommWrData(eot);
- |Telink: CommWrData(eot);
- END;
- EXIT
- END;
- fi := NFIO.Open(ThisFile^.Name);
- IF fi = MAX( CARDINAL) THEN
- PressKey( OpenError );
- ELSE
- Errors := 0;
- totalErrors := 0;
- IF NOT StartingAck() THEN
- EXIT; (* INCLUDES ABORT *)
- END;
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- IF Protocol IN ZeroBlockProtos THEN
- BlockNum := 0;
- IF CreateBlock[Protocol]
- (ThisFile^.Name, FileName, Buffer ) = 0 THEN
- EXIT
- END;
- IF (Protocol = Telink) THEN
- IF NOT SendTelinkName() THEN
- IF NOT Aborting THEN (* ABORT *)
- GracefulAbort(NoTransferMsg)
- END;
- EXIT
- ELSIF NOT StartingAck() THEN
- EXIT (* INCLUDES ABORT *)
- END;
- END;
- IF NOT BlockSent(128,
- UsingCRC AND (Protocol <> Telink), FALSE ) THEN
- IF NOT Aborting THEN
- GracefulAbort(NoTransferMsg)
- END;
- EXIT
- ELSIF (Protocol = YModem) AND (NOT StartingAck()) THEN
- IF NOT Aborting THEN
- GracefulAbort(NoTransferMsg)
- END;
- EXIT
- END;
- END;
- SendFile;
- IF Aborting THEN
- EXIT
- END;
- Errors := 0;
- REPEAT
- CommWrData(eot);
- c := GetAck(SendDelay, NUMSET{ack});
- IF c <> ack THEN (* INCLUDES ABORT *)
- INC(Errors)
- END
- UNTIL (c IN NUMSET{ack, can, esc}) OR (Errors >= MaxErrors);
- NFIO.Close(fi);
- WHILE CommRdData(0) < 0100H DO END; (* Flush *)
- END; (* ELSE *)
- FlushLog;
- ThisFile := ThisFile^.Next
- END; (* LOOP *)
- DISPOSE( Buffer );
- setXon( TRUE, TRUE );
- StopDisplay;
- END SendXmodem;
-
- END QCxm.
-